home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / chrchpr2.arc / CSETCHNG.CMD < prev    next >
Encoding:
Text File  |  1979-12-31  |  4.0 KB  |  123 lines
  1. * Program CSETCHNG - Changes or Deletes lodging Room/Bed assignments.
  2. * Called by CSETRANS from selecting 3-C or 3-D                        CSEVENTS
  3. * By Rod Williams; WaterWares, March, 1985.
  4.      Store xsel+'      ' to xsel
  5.      Store $(xsel,2,5) to inbed
  6.      If inbed='     '
  7.        Accept "Enter a person's number " to inbed
  8.      endif
  9.      If !(inbed)<>'Q    ' .and.inbed<>'     '
  10.        Select secondary
  11.        Store val(inbed) to ixx
  12.        If ixx>II
  13.          ? 'This number not assigned.'
  14.        else
  15.          Store $(inumbs,ixx*5,5) to oldrec
  16.          GOTO &oldrec
  17.          Store $(spact,1,10) to infind
  18.          Store $(spact,12,11) to nfind
  19.          Store trim($(spact,24,10)) to ffind
  20.          Select primary
  21.          Store F to nfound
  22.          If NFIND<>'           '
  23.           Find &NFIND
  24.           If #<>0
  25.            Do while last:name=nfind .and. first:name<>ffind.and. .not. EOF
  26.              SKIP
  27.            enddo
  28.            If last:name=nfind.and. first:name=ffind
  29.              Store T to nfound
  30.            endif
  31.           endif
  32.          endif
  33.          If nfound
  34.            Store nfind+' '+ffind to nfind
  35.            Store 'for '+nfind to nnfind
  36.          else
  37.            Store '                 ' to nnfind
  38.          endif
  39.          If !(xsel)='D'
  40.              ? 'Now deleting -',nfind,' ... ',$(S.spact,1,10)
  41.              If nfound
  42.                Replace transpor with ' '
  43.              endif
  44.              Select secondary
  45.              Replace spact with $(spact,1,10)+'.'+$(spact,12,28)
  46.              DELETE
  47.          else
  48.             If nfound
  49.              Store F to chold
  50.              If transpor=$(infind,6,5) .or.transpor='     '
  51.                Store T to chold
  52.              else
  53.  ? 'The Transportation assignment in MEMBERSE does not match for this person.'
  54.               Store sfield to sfieldx
  55.               Select secondary
  56.               Find &sfieldx
  57.               If #<>0
  58.                 ? 'The Name is cleared in the EDIRFILE.  '
  59.                 GOTO &oldrec
  60.                 Replace spact with $(spact,1,10)+'.'
  61.               else
  62.                 ? "This person's Transportation is being re-assigned."
  63.                 Store T to CHOLD
  64.               endif
  65.              endif
  66.              If CHOLD
  67.                Accept 'Enter a new Transportation assignment ' to inbed1
  68.                Store inbed1+'    ' to inbed1
  69.                If !(inbed1)<>'Q    ' .and. inbed1<>'     '
  70.                 Store T to RBCHANGE
  71.                 Store F to RBAPPEND
  72.                 Store sfield to sfieldx
  73.                 Select secondary
  74.                 Store 'TRAN='+$(inbed1,1,5)+' ' to xx
  75.                 Find &xx
  76.                 If #=0
  77. ? 'This Transportation name, "',$(inbed1,1,5),'" not found. No change made.'
  78.                   Store F to RBCHANGE
  79.                 else
  80.                   Store T to RBAPPEND
  81.                 endif
  82.                 If RBCHANGE
  83.                    ? 'Now replacing',infind,'with',xx,nnfind
  84.                    Select primary
  85.                    Replace transpor with inbed1
  86.                    Select secondary
  87.                    GOTO &oldrec
  88.                    Replace spact with $(spact,1,4)+'>'
  89.                    If RBAPPEND
  90.                      Append blank
  91.                      Store II+1 to II
  92.                      Replace spact with xx+nfind
  93.                    endif
  94.                 endif  * RBCHANGE
  95.                endif
  96.              endif
  97.             else
  98.              Set raw on
  99. ? 'Name "',nfind,ffind,'" is not found in MEMBERSE. Now cleared from EDIRFILE.'
  100.              Set raw off
  101.              Select secondary
  102.              GOTO &OLDREC
  103.              Replace spact with $(spact,1,10)+'.'
  104.              DELETE
  105.             endif
  106.            endif
  107.        endif  * #=0
  108.     endif
  109.     Store 'C' to xsel
  110. RETURN
  111.  
  112. N
  113.  
  114. 
  115.     Store 'C' to xsel
  116. RETURN
  117.  
  118. Find &NFIND
  119.          If #<>0
  120.            Do while last:name=nfind .and. first:name<>ffind.and. .not. EOF
  121.              SKIP
  122.            enddo
  123.            If last:name=nfind.and. first